
;; =============================================================================
;; sample code
(defparameter *ed-unroll-structs*
  '(marked-code

    ;; describe Animal type
    (type Animal
     (int legs)
     (int claws)
     (int ears))

    ;; describe function that performs shallow visiting of the structure's members
    (func shallow-visit (instance visit)
     ;; type-of is compile-time function
     (let (type (type-of instance))
       (case (get kind type)
         pointer (error "pointer is not expected")
         
         builtin (visit instance stream)

         complex (foreach (field (get fields type))
                          (shallow-visit stream (get field instance)))
         
         default (error))))

    ;; shallow serializer
    (func shallow-serialize (stream instance)
     (let (visit (lambda (stream instance) (serialize stream instance)))
       ;; FIXME: do it?? -        (put-constraint visit compile-time)
       (shallow-visit instance visit)))

    ;; eof
    (nop)))

#|

oali parser spec:

1. Define problem scope.
2. Find a way to solve the problems defined in 1
3. Solutions components dependencies/links review.

;; =============================================================================
;; Tasks

1-1. Generic algorith related to a simple data type
     - simple sort
     - AVL-tree
     - graph

1-2. Data representation associated with a query given (built-in DSL).
     Data queries a-la LINQ => code generation related to data request and
     describing related data sources.

1-3. OOP: encapsulation, inheritance and polymorphism - how it will be
     represented at language level? Compile-time level? Run-time level?

1-4. Event "emitting-notification" mechanism. Signal-slot mechanism to be clarified.
     Extensible data structures.
     Concept: [Signal + Data + Set of slots].

1-5. Error handling layer. Block that catches errors and gathers information about
     them.

1-6. Multithreading and approaches to parallelism to be clarified.

1-7. Declarative (a.k.a. XAML) approaches to write UI.

1-8. Problem domain's dictionary integration to be clarified.

|#


;; =============================================================================
;; task 1.1: simple sort (straight insertion sort for particular sequence)
(defparameter *task-1.1-simple-sort-1*
  '(
    ;; external types
    (type Element)		        ; element of the Sequence to be sorted
    (type ElementRef)			; provides reference to Element
    (type Sequence)			; container type
    (type Int)				; integer indexed type

    ;;(type bool (builtin bool))		; bool is the same builtin bool type (redundant???)
    
    ;; external less function
    (func < ((Element lhs) (Element rhs)) (returns bool))

    ;; external swap function
    (func swap ((ElementRef lhs) (ElementRef rhs)) (returns void))

    ;; external length function that applies for Sequence
    (func length ((Sequence s)) (returns Int))

    ;; external function that represents indexed accessor to a sequence given
    (func elem ((Sequence s) (Int index)) (returns ElementRef))

    ;; external constraint that implies ElementRef shall be used as Element
    (constraint (default-adapter ElementRef Element))
    (constraint (default-adapter Int integer-type))
    

    ;; bubble sort
    (func bubble-sort ((Sequence s))
     (let ((bool swapped true))
       (while swapped
        (let ((Int i))
          (set swapped false)
          (for ((i 0) (< i (- (length s) 1)) (inc i))
               (progn
                 (if (<(elem arr i) (elem arr (+ i 1)))
                     (progn
                       (swap (elem arr i) (elem arr (+ i 1)))
                       (set swapped true)))))))))

    ;; insertion sort
    (func insertion-sort ((Sequence s))
     (let ((Int i))
       (for ((i 1) (< i (length s)) (inc i))
	    (let ((Element value (elem arr i))
		  (Int j (- i 1)))
	      (while (< (elem arr j) value)
		(set (elem arr (+ j 1)) (elem arr j))
		(set (elem arr j) value)
		(dec j)
		(if (< j 0) break))))))
    
    ))

;; =============================================================================
;; task 1.1: alternative approach to sort op (simple one)
(defparameter *task-1.1-bubble-sort-2*
  '(
    ;;;;
    ;; external types
    (type Element)
    (type Container)

    ;;;;
    ;; exported function
    (func bubble-sort (container)
     (let ((swapped true))
       (while swapped
	 (let (i)
	   (set swapped false)
	   (for ((i 0) (< i (- (length container) 1)) (inc i))
		(if (< (elem container i) (elem container (+ i 1)))
		    (progn
		      (swap (elem container i) (elem container (+ i 1)))
		      (set swapped true))))))))
    ))

#|
analysis scheme of *task-1.1-bubble-sort-2*:
1. proxy type Element
2. proxy type Container
3. declaring function bubble-sort
4. it requires:
 - type of i
 - type of container
 - function < that returns boolean
 - function length that takes container and returns
... to be completed
|#


;; =============================================================================
;; task 1.2: AVL tree
(defparameter *task-1.2-avl-tree-1*
  '(
    ;;;;
    ;; external types (User Provided)
    (type Key)

    ;;;;
    ;; external functions (User provided)
    (func compare ((Key lhs) (Key rhs)) (returns Int))

    ;;;;
    ;;;;
    ;; all the other stuff is either has default implementations
    ;; or is implemented/defined here
    
    

    ;; internal types
    (type Node (includes
		(Key key)
		(Node left-child)
		(Node right-child)
		(Int balance)))

    (type Tree (includes
		(Node root)		; tree's root element
		(Node sentinel)		; sentinel to specify null leaf nodes
		))

    ;;;;
    ;; external (user of system-provided) types
    (type Int (default integer-type))

    ;;;;
    ;; external system (or user)-provided functions
    (func alloc-node (tree) (returns Node))
    (func dispose-node ((Node node)) (returns void))
    
    ;;;;
    ;; constraints and roles
    (roles

     ;; alloc-node's shall be used if corresponding  tree instance is available
     (constructor alloc-node)		; constructor constraint
     
     ;; -//- same thing for dispose-node
     (destructor dispose-node)

     ;; functions to be exported (e.g. externally visible)
     (export init-tree)
     (export uninit-tree)
     (export find-node))

    ;; initializes tree instance
    (func init-tree ((Tree tree))
     (progn
       (set (root tree) (sentinel tree))))

    ;; uninitializes tree instance
    (func uninit-tree ((Tree tree))
     (progn))

    ;; finds node
    (func find-node ((Tree tree) (Key key))
     (let ((Node node (root tree))
	   (Node sentinel (sentinel tree)))

       ;; set sentinel key (it will be equal to the searched one)
       (set (key sentinel) key)

       ;; start search (forever <=> infinite loop)
       (forever
	(let ((cmp (compare (key node) key)))
	  (if (< cmp 0)
	      (set node (right node))
	      ;; else
	      (if (> cmp 0)
		  (set node (left node))
		  ;; else - cmp=0
		  (break)))))))


    ;; encloses facilities for add-node
    (module "add-node-module"
     ;; allocates new node
     (func alloc-new-node (tree key)
      (let ((node (alloc-node tree)) ; Node * node = alloc_node(tree->allocator);
	    (sentinel (sentinel tree))	; Node * sentinel = tree->sentinel
	    )
	(set (key node) key)		; node->key = key
	(set (left node) sentinel)	; node->left = sentinel
	(set (right node) sentinel)	; node->right = sentinel
	(set (balance node) 0)		; node->balance = 0
	(return node)			; return node
	))
     
     ;; adds node
     (func add-node ((Tree tree) (Key key))
      (let (
	    ;; newly added node or found one
	    (Node new-node)
	    ;; indicates whether new-node is found somewhere in tree or newly created
	    (bool found))
	
	;; TODO: add method implementation
	(error "not implemented")

	;; the last clause is a return statement
	;; return tuple: new-node and found
	(return new-node found))))

    

    ;; removes node
    (func remove-node ((Tree tree) (Key key))
     (let ((bool found))
       (error "not implemented")

       ;; returns 
       found))


    ;; void internal_foreach(ForeachContext * context, Node * node)
    (func internal-foreach (context node)
     ;; if (node != context->tree->sentinel) ...
     (if (/= node (sentinel tree-context))
	 (internal-foreach tree-context (left node)) ; internal_foreach(context, node->left)
	 (foreach-callback tree-context node) ; context->foreach_callback(context, node)
	 (internal-foreach tree-context (right node)) ; internal_foreach(context, node->right)
	 ))

    ;; iterates over the tree nodes
    (func foreach-node ((Node node))
     ())
    ))

;; =============================================================================
;; task X.X: placeholder
(defparameter *task-X.X-descplaceholder-1*
  '())
